perm filename NOTWRT.F4[P11,LCS] blob
sn#585798 filedate 1981-05-13 generic text, type T, neo UTF8
C**** NOTWRT, STEM
SUBROUTINE NOTWRT
COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM,JWHOLE
COMMON /STF/RSTFAC(0/7),RSTJ2 /WIDTH/WID1,WID2,WIDX
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
COMMON /POSI/STFF(0/7),JJ2,POS
C ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ,
1 PUNCT,JY,RJ
EQUIVALENCE (J4,JQ(2)),(J5,JQ(3)),(R4,RJQ(2)),(J9,JQ(7))
1,(R6,RJQ(4)),(J7,JQ(5)),(J10,JQ(8)),(J11,JQ(9)),(J6,JQ(4))
1,(R3,RJQ(1)),(RX4,JQ(19)),(R12,RJQ(10)),(RLVL,RJQ(20))
1,(R7,RJQ(5))
DATA WID1/14.54/,WID2/16.2/
C NOTES****
RMINI=RSTJ2
RST7=7.*RMINI
IF(JA.EQ.1)GO TO 11
IF(JA.NE.9)GO TO 90
CALL MRKX
RETURN
90 CALL RST
C GO MAKE A REST
RETURN
11 JSTEM=J5/10
JWHOLE=IABS(J6)
IF(JWHOLE.EQ.30)JWHOLE=0
C 30 IS USED IN NOTBMS & RHYTH.
JACC=MOD(J5,10)
C THE ACCIDENTAL NUM.
JTAIL=MOD(J7,10)
C HOW MANY TAILS
JDOT=J7/10
C HOW MANY DOTS
NTYPE=(IABS(J4)+20)/100
C NOTE TYPE CODE NUMBER (0,1,2,3,4,5)
RLVL=AMOD(R4,100.)
C TRUE LEVEL OF NOTE. USED IN ACCI.
IF(J10.LE.0)GO TO 9
POS=STFF(J2-3+2*J10)
C FOR PUTTING NOTES ON STAFF ABOVE OR BELOW. J10=1=DOWN, =2=UP
CALL CENTX
9 MKS=J11
C ANY MARKS?
JJ4=RLVL
RJAC=R3
C SAVE HOR. POS. FOR OTHER ROUTINES
IF(R12.NE.0)RMINI=RMINI*R12
C R12 HAS NEW, MASTER SIZE FACTOR
GO TO (1,2,3,3,5,6)NTYPE+1
1 CALL ORDNT
7 IF(JJ4.LT.2)GO TO 8
IF(JJ4.LT.13)GO TO 10
8 IF(J9.NE.-1)CALL LDGLN
10 IF(JDOT.EQ.0)GO TO 12
RJX=RJAC+(22.+AMOD(R7,1.0)*59.6)*RMINI
C RJAC IS ORIGINAL R3 (RESTS ALSO USE DOTIT)
CALL DOTIT
12 IF(JACC.NE.0)CALL ACCI
IF(JSTEM.GT.0)CALL STEM
IF(JTAIL.NE.0)CALL TAILS
IF(MKS.NE.0)CALL MRK
RETURN
2 RMINI=RMINI*.6
C FOR MINI (GRACE) NOTES
GO TO 1
3 CALL DIAMND
GO TO 7
5 RB=R6*RST7
C USE R6 TO ADJUST SOURCE POS. OF HEADLESS NOTES (WAS R12)
J6=0
GO TO 7
6 CALL EXTRA
C GO USE SPECIAL NOTE PACKAGE
END
SUBROUTINE STEM
COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM
COMMON /STF/RSTFAC(0/7),RSTJ2 /WIDTH/WID1,WID2,WIDX
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
C ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ,PUNCT,JY,RJ
EQUIVALENCE (J5,JQ(3)),(J7,JQ(5)),(J10,JQ(8)),
1(J6,JQ(4)),(R5,RJQ(3)) ,(R8,RJQ(6)),(R3,RJQ(1))
RG=(JTAIL-1)*14
IF(RG.LT.0)RG=0
C 999 IS STANDARD (0) STEM LENGTH.
IF(R8.NE.999.)GO TO 1751
R8=0
RH=0
GO TO 2751
1751 IF(R8.LT.999.)GO TO 751
R8=R8-1000.
J10=-1
C +1000 PUTS SLASH ON NOTE STEM
751 RH=R8*RST7
2751 IF(JSTEM.NE.2)GO TO 1280
C STEM EXTENSIONS ARE BY NOTE #S
RJX=R3
C FOR STEM DOWN (=2)
RG=-RG-48.
RH=-RH
C RB IS SOURCE POS. OF STEM. SET UP IN VARIOUS NOTE ROUTINES.
RB=-RB
C FOR TILT OF ORDINARY NOTES (NOT X OR DIAMOND)
GO TO 129
C NEXT IS FOR STEM UP.
1280 RJX=WIDX
CC IF(J6.LT.0)RJX=WID2
C IF(J6.LT.0)GET SPACE FOR HALF NOTE
2322 RJX=RJX*RMINI+R3
RG=RG+48.
129 RZ=CENTR+RH+RG*RMINI
RB=RB+CENTR
CALL LINX(RJX,RB,RJX,RZ)
C MOVES CENTR UP OR DOWN FOR NEXT TAIL
END